Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dbsteel1.arc / ASCII.BAS next >

Wrap

BASIC Source File | 1983-03-10 | 10.1 KB | 375 lines

3 DEFDBL X 4 DEFINT A-W,Y-Z 5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30) 10 DIM X$(30) 13 DIM L(15),NREC(15) 14 DIM X(20) 20 DIM XL(40) 35 DIM K$(80) 61 CH = 29: PRINT FRE(0) 70 NE = 0 75 GOSUB 50000 80 GOSUB 10000 400 GOSUB 13000 404 GOSUB 13000 410 PRINT "********** ASCII PROGRAM -- WHAT FILE DO YOU WANT: **********" 420 PRINT "" 425 PRINT " 0 - *** EXIT THE PROGRAM ***" 430 FOR I = 1 TO MAXF 440 PRINT I;" - ";F$(I) 450 NEXT I 460 PRINT "" 470 PRINT "***** ENTER THE NUMBER OF THE FILE YOU WANT THEN PRESS RETURN *****" 475 GOSUB 14000 477 IF DT# < 0 OR DT#>MAXF GOTO 475 480 A = DT# 482 IF A = 0 GOTO 51000 483 GOSUB 13000 484 PRINT "FILE : "; F$(A) 485 GOSUB 2300 490 GOSUB 2500 495 GOSUB 8000 500 GOTO 6000 2300 REM ************** DISK SELECTION *************** 2302 IF HDISK = 2 THEN GOSUB 13000 2303 IF HDISK = 2 THEN GOTO 2360 2304 PRINT "" 2305 PRINT "************ WHICH DISK DRIVE IS THE FILE ON **************" 2310 PRINT "" 2315 PRINT " 1 - DISK DRIVE A" 2320 PRINT " 2 - DISK DRIVE B" 2325 PRINT " 3 - DISK DRIVE C" 2330 PRINT " 4 - DISK DRIVE D" 2335 PRINT "" 2340 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ************" 2345 GOSUB 14000 2347 IF DT# < 0 OR DT#>4 GOTO 2345 2350 T = DT# 2355 ON T GOTO 2360,2370,2380,2390 2360 T$ = F$(A) 2365 GOTO 2490 2370 T$ = "B:"+F$(A) 2375 GOTO 2490 2380 T$ = "C:"+F$(A) 2385 GOTO 2490 2390 T$ = "D:"+F$(A) 2490 RETURN 2500 REM ******* OPEN FILE SUBROUTINE ******* 2503 CLOSE #1 2505 OPEN "R",#1,T$,L(A) 2507 D = 0 2510 FOR T = 1 TO NREC(A) 2520 FIELD #1,D AS DY$,FL(A,T) AS X$(T) 2530 D = D + FL(A,T) 2540 NEXT T 2543 GOSUB 7800 2545 RETURN 6000 REM ***** CHANGE TO SEQUENTIAL ASCII FILE 6075 GOSUB 13000 6100 PRINT " This program converts the records you specify to " 6110 PRINT " to a sequential ASCII form" 6120 PRINT "" 6278 PRINT "******** WHAT RECORD DO YOU WANT TO START AT *********" 6281 PRINT "" 6282 PRINT " Enter Zero When you are done " 6283 PRINT "" 6284 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN *********" 6287 GOSUB 14100 6288 IF DT# <0 OR DT# > MRN GOTO 6287 6290 RNS= DT# 6300 IF RNS = 0 THEN 51000 6375 PRINT "" 6378 PRINT "********* WHAT RECORD DO YOU WANT TO END AT *********" 6381 PRINT "" 6384 PRINT "******** ENTER THE NUMBER THEN PRESS RETURN *********" 6387 GOSUB 14100 6388 IF DT# <1 OR DT# > MRN GOTO 6387 6390 RNF= DT# 6396 REM GET RECORD 6399 FOR T = RNS TO RNF 6402 GET #1,T 6403 GOSUB 6417 6404 PRINT #2,"" 6405 NEXT T 6406 GOSUB 13000 6407 PRINT "*** ANY MORE RECORDS TO CONVERT ***" 6410 GOTO 6100 6417 FOR Q = 1 TO NREC(A) 6435 ON FTY(A,Q) GOSUB 6507,6441,6453,6465,6465 6436 IF Q < NREC(A) THEN PRINT #2,CHR$(44); 6438 NEXT Q 6439 RETURN 6440 REM ************** CONVERT STRINGS TO DECIMALS **************** 6441 I%=CVI(X$(Q)) 6447 PRINT #2,I%; 6450 RETURN 6453 I!=CVS(X$(Q)) 6459 PRINT #2,I!; 6462 RETURN 6465 I#=CVD(X$(Q)) 6468 PRINT #2,I#; 6471 RETURN 6507 I$ = X$(Q) 6508 PRINT #2,CHR$(34);I$;CHR$(34); 6510 RETURN 7800 MRN = LOF(1)/ L(A) 7805 REM MRN = INT(MRN) 7810 RETURN 7900 REM ***** LOF 7910 MRN2 = LOF(3)/82 7920 RETURN 7950 REM ******* LOF 7960 MRNS = LOF(B)/L(B) 7970 RETURN 8000 REM ****** OPEN ASCII FILE 8100 OPEN "O",#2,"ASCIDATA" 8200 RETURN 9070 ON FTY(A,N) GOTO 9100,9150,9200,9250,9250 9100 REM 9110 LSET X$(N) = I$ 9120 GOTO 9290 9150 REM 9160 LSET X$(N) = MKI$(I#) 9170 GOTO 9290 9200 REM 9210 LSET X$(N) = MKS$(I#) 9220 GOTO 9290 9250 REM 9260 LSET X$(N) = MKD$(I#) 9290 RETURN 10000 REM ************* READ SUBROUTINE ************* 10004 GOSUB 10900 10010 OPEN "I",#1,"FFILE" 10020 INPUT #1,MAXF 10030 FOR A = 1 TO MAXF 10040 INPUT #1,A,F$(A),NREC(A),L(A) 10050 FOR N = 1 TO NREC(A) 10060 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N) 10070 IF FTY(A,N) = 2 THEN INPUT #1,D,D 10080 NEXT N 10090 NEXT A 10100 CLOSE #1 10110 RETURN 10900 REM ************* PUT DISK IN DRIVE SUB 10905 IF HDISK = 2 THEN RETURN 10910 GOSUB 13000 10920 PRINT " ******** PUT PROGRAM DATA DISK IN THE DEFAULT DISK DRIVE *********" 10930 PRINT "" 10940 PRINT " THEN PRESS ANY KEY TO CONTINUE " 10950 PRINT "" 10960 PRINT " If the program data disk is already in the default disk drive then" 10965 PRINT " just press any key to continue." 10970 PRINT "" 10990 IF INKEY$ = "" GOTO 10990 10995 RETURN 13000 REM ********* CLEAR SCREEN 13010 CLS 13020 RETURN 13100 REM ********* LOCATE 13110 LOCATE LI,1 13120 RETURN 13200 FOR T% = 1 TO 80 13210 PRINT CHR$(8); 13220 NEXT T% 13222 FOR T% = 1 TO 24 13223 PRINT CHR$(11); 13224 NEXT T% 13225 LI = LI - 1 13230 FOR T% = 1 TO LI 13240 PRINT CHR$(0) 13250 NEXT T% 13590 RETURN 13600 REM ****** CHECK FOR ASC0 13610 S4$ = INKEY$ 13620 C2 = ASC(S4$) 13630 IF C2 = 83 THEN C = 1 13640 IF C2 = 82 THEN C = 6 13650 IF C2 = 75 THEN C = 19 13660 IF C2 = 77 THEN C = 4 13670 RETURN 14000 REM ******* INTEGER LESS THEN 100 CHECK ******** 14010 MAX = 2 14020 ACT$ = "1234567890=<>^" 14023 IF NE = 0 THEN ACT$ = "1234567890" 14025 PRINT ">__<"; 14030 GOTO 14500 14100 REM ******* INTEGER ******* 14110 MAX = 8 14120 ACT$ = "1234567890-+,=<>^" 14123 IF NE = 0 THEN ACT$ = "1234567890-+," 14125 PRINT ">________<"; 14130 GOTO 14500 14200 REM ******* SINGLE PRECISION ******* 14210 MAX = 10 14220 ACT$ = "1234567890-+,.%$=<>^" 14223 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 14225 PRINT ">__________<"; 14230 GOTO 14500 14300 REM ******* DOUBLE PRECISION ******* 14310 MAX = 20 14320 ACT$ = "1234567890-+,.%$=<>^" 14323 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 14325 PRINT ">____________________<"; 14330 GOTO 14500 14500 REM ********** NUMBER CHECK ********** 14505 A$ = "" 14510 K$(20) = " " 14515 KTMAX = 0 14520 FOR T9 = 1 TO MAX 14525 K$(T9) = " " 14530 NEXT T9 14535 DIG$ = "1234567890." 14540 DOTFLG = 0 14541 T2 = MAX + 1 14542 FOR T6 = 1 TO T2 14544 PRINT CHR$(CH); 14546 NEXT T6 14550 IF INKEY$ = "" GOTO 14560 ELSE GOTO 14550 14560 KT = 0 14565 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH *********** 14570 KT = KT + 1 14575 REM 14580 W$ = INKEY$ 14585 IF W$ = "" GOTO 14580 14590 C = ASC(W$) 14593 IF C = 0 THEN GOSUB 13600 14595 IF C = 13 GOTO 14660 14600 IF C = 17 OR C = 8 GOTO 14860 14605 IF C = 19 GOTO 14690 14610 IF C = 4 GOTO 14710 14615 IF C = 6 GOTO 14730 14620 IF C = 1 GOTO 14790 14625 IF KT > MAX GOTO 14575 14630 IF INSTR(ACT$,W$) = 0 GOTO 14890 14635 K$(KT) = W$ 14645 PRINT K$(KT); 14650 IF KT > KTMAX THEN KTMAX = KT 14655 GOTO 14570 14660 REM ********** RETURN ********** 14670 FOR T9 = 1 TO KTMAX 14675 A$ = A$ + K$(T9) 14680 NEXT T9 14681 IF KTMAX = 0 THEN PRINT "1" 14682 IF KTMAX = 0 THEN DT# = 1 14683 IF KTMAX = 0 THEN RETURN 14684 PRINT "" 14685 GOTO 14905 14690 REM ********* MOVE CURSE BACK ******** 14695 IF KT = 1 GOTO 14575 14700 KT = KT - 1 14703 PRINT CHR$(CH); 14705 GOTO 14575 14710 REM ********* MOVE CURSER FORWARD ********* 14715 IF KT >= MAX GOTO 14575 14716 IF KT > (KTMAX + 1) GOTO 14575 14718 PRINT K$(KT); 14720 KT = KT + 1 14725 GOTO 14575 14730 REM ********** INSERT *********** 14733 IF KT > KTMAX GOTO 14575 14735 X9 = MAX 14740 WHILE X9 > KT 14745 X9 = X9 - 1 14750 K$(X9 + 1) = K$(X9) 14755 WEND 14760 K$(KT) = " " 14767 KTMAX = KTMAX + 1 14769 IF KTMAX > MAX THEN KTMAX = MAX 14770 FOR T9 = KT TO KTMAX 14775 PRINT K$(T9); 14780 NEXT T9 14781 T6 = (KTMAX - KT) + 1 14782 FOR T7 = 1 TO T6 14783 PRINT CHR$(CH); 14784 NEXT T7 14785 GOTO 14575 14790 REM ********** DELETE *********** 14793 IF KT > KTMAX GOTO 14575 14794 IF KTMAX = 1 GOTO 14575 14795 K$(MAX + 1) = "" 14800 X9 = KT 14805 WHILE X9 <= MAX 14810 K$(X9) = K$(X9 + 1) 14815 X9 = X9 + 1 14820 WEND 14830 KTMAX = KTMAX - 1 14835 FOR T9 = KT TO KTMAX 14840 PRINT K$(T9); 14845 NEXT T9 14850 PRINT "_"; 14851 T7 = (KTMAX - KT) + 2 14852 FOR T8 = 1 TO T7 14853 PRINT CHR$(CH); 14854 NEXT T8 14855 GOTO 14575 14860 REM ********* BACKSPACE ******** 14865 IF KT = 1 GOTO 14575 14870 KT = KT - 1 14875 PRINT CHR$(CH); 14877 K$(KT) = " " 14880 PRINT "_"; 14883 PRINT CHR$(CH); 14885 GOTO 14575 14890 REM ******* INPUT NOT ACCEPTABLE ******** 14895 PRINT CHR$(7); 14900 GOTO 14580 14905 REM ********* CLEAR STRINGS ******** 14910 MAX = LEN(A$) 14915 D2$ = "" 14920 D1$ = "" 14925 DFLG = 0 14930 FOR Q93 = 1 TO MAX 14935 R$ = MID$(A$,Q93,1) 14940 IF INSTR(DIG$,R$) = 0 GOTO 14975 14945 IF R$ = "." OR DFLG = 1 GOTO 14965 14950 IF DFLG = 1 GOTO 14965 14955 D2$ = D2$ + R$ 14960 GOTO 14975 14965 D1$ = D1$ + R$ 14970 DFLG = 1 14975 NEXT Q93 14980 DA# = VAL(D2$) 14985 D1# = VAL(D1$) 14990 DT# = DA# + D1# 14995 IF K$(1) = "-" THEN DT# = -DT# 14997 RETURN 26000 REM ******* ON ERROR ROUTINE ************ 26100 EFLG = 1 26200 PRINT "********** END OF FILE ***********" 26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****" 26204 IF INKEY$ = "" GOTO 26204 26500 REM ********* ON ERROR SUBROUTINE *********** 26600 PRINT "********** END OF FILE ***********" 26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****" 26620 IF INKEY$ = "" GOTO 26620 26635 EFLG = 1 26640 RETURN 26800 REM ********** ON ERROR GOTO ************** 26900 PRINT "************ RECORD NOT FOUND *************" 41000 REM ***** WRITE SECOND FILE 41100 LSET Y$ = XT$ 41200 PUT #2,RN2 41300 RN2 = RN2 + 1 41400 RETURN 50000 REM ********** INTRO 50010 GOSUB 13000 50100 PRINT " A S C I I P R O G R A M 3.0 " 50105 PRINT "" 50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc." 50120 PRINT "" 50130 PRINT "This program is licensed FREE to all users with some restrictions" 50165 PRINT " See the manual for more information on the license." 50167 PRINT "" 50950 PRINT "****************** PRESS ANY KEY TO CONTINUE ******************"; 50960 IF INKEY$ = "" GOTO 50960 50970 RETURN 51000 REM ******* DONE 51100 CLOSE 51105 GOSUB 13000 51110 PRINT " -BYE, Have a nice day 51120 END 50960 50970 RETURN 51000 REM ******* DONE 51100 CLOSE 51